perm filename DRWF.F4[MSS,LCS] blob
sn#104336 filedate 1974-05-25 generic text, type T, neo UTF8
00100 C TYPE 'DO DOD.DO'.
00110 C 'G' OR <CR> = GET. 'A'=ADD TO COMBINED FILE.
00200 C PC=PLOT PX=XGP(→PLOT.BIN) PXS,PCS=PLOT SMOOTHED CONTURE
00300 C PXZ,PCZ=PLOT SMOOTHED CONTURE AND FILL IT.
00400 C IN DRAW SECTION: J=JUMP(INVIS. VECT.)
00500 C F=JUMP AND BEGIN FILL SECTION. FX=EXIT AND FILL ALL.
00600 C SINGLE ITEM IS RESTRICTED TO 400 WDS. 10 ITEMS PER FILE.
00700 COMMON /RC/MCLEF(400),IST(4000)
00800 COMMON /FL/IC,N,NQ,RZ,IXRX,XGP,RXGP
00900 COMMON/ZN/SCLEF(400,2),DDD
01000 COMMON/ED/KED,NEXT,NN,NX,NY,J
01100 COMMON XX(100),G(100),NJ,QF(512),RF(512),S(100),K
01200 COMMON/LL/LL
01300 DIMENSION JCLEF(10)
01400 COMMON/NFF/NF(513)
01500 EQUIVALENCE (MM,SCLEF(1,1)),(JCLEF,IST),(NM,IXRX)
01510 1 ,(GRID,IST(4000))
01600 COMMON /RZ/RSZ,IPLT,RJB,CENTR
01700 DATA RJB/-20./,CENTR/-26./
01710 RSZ=0
01800 1 MCLEF(1)=0
02000 MM=0
02100 IPLT=0
02200 IPLTX=-1
02300 K=1
02500 91 TYPE 100
02600 55 FORMAT(I,2F)
02700 50 FORMAT(3A1)
02900 XSZ=RSZ
03000 ACCEPT 55,J,RSZ,GRID
03200 IF(RSZ.EQ.0)RSZ=XSZ
03300 MORE=-1
03400 REREAD 50,N,JC,JS
03410 IF(N.EQ.' ')GO TO 91
03500 C PXS,PCS=SMOOTH ONLY; PXZ,PCZ=SMOOTH AND FILL
03600 C TO SAVE SIZE FACTOR WHEN REDRAWING.
03610 IF(N.EQ.'Z')GO TO 1
03700 IF(RSZ.EQ.0)RSZ=9.0
03710 IF(GRID.NE.0.AND.N.NE.'P')CALL GRIDS
03800 IF(N.EQ.'M'.OR.N.EQ.'R')GO TO 192
03900 C FOR ROTATION OR MOVING AND DISTORTING ENTIRE PICTURE
03910 IF(N.EQ.'F')GO TO 79
03930 C FILLS IT.
03950 IF(JS.EQ.'L')N='Z'
03975 C DEL=DELETE FROM COMB. FILE. (JS='L')
04000 IF(N.EQ.'C'.OR.N.EQ.'A'.OR.N.EQ.'Z')GO TO 999
04100 IF(N.EQ.'X')CALL EXIT
04200 C TYPE X TO FINISH PLOT, OTHERWISE NEW UNIT MAY BE READ IN.
04300 IF(N.EQ.'Q')GO TO 56
04350 C 'Q' MAKES CURRENT DPY IN BACKGROUND ON POG2
04400 IF(N.NE.'D'.AND.N.NE.'E')GO TO 191
04410 IF(JC.EQ.'X')MCLEF(1)=0
04420 C TYPE 'DX' TO START NEW DRAWING WITHOUT EXIT. (GOOD AFTER 'Q')
04500
04600 KED=N
04700 MM=MCLEF(1)
04800 IF(MM.NE.0)GO TO 92
04900 C ADD TO DRAWING?
05000 GO TO 3
05010
05020 56 CALL POG2
05030 CALL RDRAW(2,MCLEF(1),MCLEF)
05035 CALL DPYOUT(2)
05040 CALL POG1
05050 GO TO 91
05100 999 CALL CMBN
05200 GO TO 111
05250 192 IF(N.EQ.'R')MCLEF(1)=-MCLEF(1)
05300 CALL SHIFT(MCLEF(2),MCLEF(1))
05400 J=1
05500 JC=0
05600 GO TO 333
05700 191 TYPE 41
05900 IF(JC.EQ.'M'.OR.N.EQ.'S')GO TO 194
06000 MCLEF(1)=0
06100 MM=0
06200 IPLTX=-1
06300 K=1
06400 194 IF(JC.EQ.'M')MORE=0
06500 JQ=JC
06600 JC=0
06700 JM=1
06900 IF(MCLEF(1).EQ.0)GO TO 193
07000 JC=JCLEF(2)-1
07100 JM=MCLEF(1)+1
07200 193 ACCEPT 10,NM,PASS
07210 IF(NM.EQ.' ')NM=LASTNM
07300 IF(NM.EQ.' '.OR.NM.EQ.'99')GO TO 91
07305 C '99' WILL BACKUP
07310 IF(N.NE.'S')LASTNM=NM
07400 REWIND 1
07500 IF(N.EQ.'S')GO TO 40
07600 IF(LOOKD(NM).EQ.0)GO TO 191
07700 C 'FAIL' ROUTINE TO CHECK ON LOOKUP
07800 CALL IFILE(1,NM)
07900 READ(1,5)M,JCLEF
08000 C CAN'T USE 'GM' WITH 'COMBINED' FILE.
08002 CC JQ=0
08005 CC IF(MORE.EQ.0.AND.JCLEF(3).NE.0)JQ=JM-1
08010 J=1
08020 IF(JCLEF(3).EQ.0)GO TO 290
08060 IF(PASS.NE.0)CALL ITEM
08100 TYPE 1100
08200 ACCEPT 55,J
08300 J=J+1
08350 C ITEMS ARE NUMBERED 0 THROUGH 9 (10 ITEMS).
08375 IF(J.GT.10)GO TO 191
08400 290 IC=JCLEF(J+1)-JCLEF(J)
08450 IF(J.EQ.10)IC=1000
08500 TYPE 110,IC
08600 IF(J.LE.1)GO TO 60
08700 C FOR PROTECTION
08800 M=JCLEF(J)+1000
08900 JZ=JM+1001
09000 NX=1001
09100 61 READ(1,5)L,L,(MCLEF(K),K=JZ,JM+L)
09200 C PASSES OVER FIRST ITEMS
09300 NX=NX+L
09400 IF(NX.LT.M)GO TO 61
09500 60 NX=JM
09550 IC=IC+JM
09600 6 READ(1,5,END=7)M,L,(MCLEF(M),M=NX,NX+L-1)
09800 NX=NX+L
09900 IF(NX.LT.IC)GO TO 6
10000 1100 FORMAT(' ITEM NUM?'/)
10100 700 FORMAT(' RESET X-Y POS. ',$)
10200 555 FORMAT(2F)
10300 7 IF(MORE)GO TO 77
10400 DO 771 K=2,JM
10500 771 IF(MCLEF(K).GE.200000000)GO TO 772
10600 GO TO 77
10700 772 M=0
10800 L=NX-1
10900 DO 773 J=K,L+JM-K
11000 M=M+1
11100 MCLEF(L+M)=MCLEF(J)
11200 C PUTS FILLER TO END
11300 773 MCLEF(J)=MCLEF(JM+M)
11400 C MOVES OUTLINE UP FRONT
11700 MCLEF(1)=L-1
11800 GO TO 3
11900 77 IF(JC.EQ.0)GO TO 70
12000 NX=MCLEF(1)+1
12100 NY=MCLEF(NX)-1
12200 C THE WDCNTS
12300 DO 71 K=NX,MCLEF(1)+NY
12400 71 MCLEF(K)=MCLEF(K+1)
12500 MCLEF(1)=MCLEF(1)+NY
12510 JCLEF(2)=MCLEF(1)+1
12600
12700 70 IF(N.NE.'P')GO TO 3
12800 IXRX=-1
12900 IF(JQ.NE.'X')IXRX=0
13000 C 0=SEND IT TO CALCOMP
13100 TYPE 700
13200 ACCEPT 555,X,Y
13300 IF(X.NE.0)RJB=X/RSZ
13400 IF(Y.NE.0)CENTR=Y/RSZ
13500 C TYPE .001, .001 TO SET POS. TO 0, -20, -26 IS ORIGINAL.
13600 IF(IPLTX)CALL PLOTS(0)
13700 C DO I NEED THIS?
13710 IF(GRID.GT.0)CALL GRIDS
13800 IPLTX=0
13900 IPLT=-1
14000 3 IF(N.NE.'D')MM=0
14100 C RESET IF NOT GOING TO DRAWIT
14400 333 IF(N.EQ.'P')GO TO 337
14500 CALL DPYSET(1,IST,4000)
14600 CALL DPYBRT(4)
14700 NIST=IST(2)
14800 IF(N.AND.N.NE.'G'.AND.N.NE.'M'.AND.N.NE.'R')GO TO 92
14900 CC337 JJ=MCLEF(1)
15000 337 IF(JS.EQ.'Z')GO TO 306
15100 IF(JS.NE.'S')GO TO 338
15200 CALL SMOOTH(JS)
15300 GO TO 436
15400 338 IC=-1
15500 MM=1
15600 DO 335 K=2,MCLEF(1)
15700 IF(MCLEF(K).LT.200000000)GO TO 335
15800 CC CALL DPYBRT(3)
15900 CC CALL RDRAW(K,MCLEF(1),MCLEF)
15910 CC CALL DPYOUT(1)
16000 CC CALL DPYBRT(4)
16100 CC JJ=K-1
16200 IC=K
16300 GO TO 334
16400 C FOR 1ST LOC. OF MCLEF IN FILLER
16500 335 CONTINUE
16600 334 CALL RDRAW(2,MCLEF(1),MCLEF)
16700 CALL DPYOUT(1)
16800 NIST=IST(2)
16900 CC IF(JJ.EQ.MCLEF(1))GO TO 436
16950 GO TO 436
17000 C NO FILLER
17010 79 IF(IC)GO TO 91
17020 C IC=-1 IF NO FILLER WAS REQUESTED WHILE DRAWING.
17100 TYPE 336
17200 ACCEPT 10,J
17300 JZ=N
17400 CC IF(J.NE.'Y'.AND.J.NE.'S')GO TO 436
17500 KK=0
17600 IF(J.NE.'Y')GO TO 206
17610 CC IF(J.NE.'S')GO TO 206
17700 306 CALL SMOOTH(0)
17750 C SMOOTHS AND FILLS
17800 GO TO 436
17900 206 RR=RSZ
18100 DO 205 J=IC,MCLEF(1)
18200 CALL UNPACK(J,M,N,MCLEF)
18300 KK=KK+1
18400 NF(KK)=0
18500 IF(LL.GE.100000000)NF(KK)=3
18600 QF(KK)=(M+RJB)*RR
18700 205 RF(KK)=(N+CENTR)*RR
18800 NF(1)=KK
18900 CALL FILLQ(QF,RF,NF)
19000 436 IF(JZ.EQ.'P')CALL PLOT(0,0,3)
19100 GO TO 91
19105
19110 66 TYPE 666,NM
19120 GO TO 91
19130 666 FORMAT(' MORE THAN ONE ITEM IN FILE ',A5/)
19200 336 FORMAT(' SMOOTH? ',$)
19300 10 FORMAT(A5,F)
19400 5 FORMAT(12I)
19500 100 FORMAT(' G=GET, GM=GET MORE, =S=SAVE, D=DRAW, X=EXIT, M=MOVE,'/'
19600 1 P=PLOT, PX=XGP, C=COMBINE, A=ADD TO COMB. FILE
19650 1, DEL=DEL. FROM COMB.'/
19700 1' F=FILL, E=EDIT, N1=SIZE, N2=1=GRID '/)
19800 C N1=20 TO CHANGE SHAPE
19900
20000 92 IST(2)=NIST
20100 CALL DRAWIT
20200 N=0
20300 GO TO 3
20400
20500 403 FORMAT(' WRITE OVER ',A5,'.DAT? ',$)
20600 41 FORMAT(' TYPE FILE NAME'/)
20700 C SAVES ONLY ONE PICTURE - USE 999(COMBINE) FOR UP TO 9
20800 40 IF(LOOKD(NM).EQ.0)GO TO 402
20900 TYPE 403,NM
21000 ACCEPT 50,K
21100 IF(K.EQ.'N')GO TO 191
21200 402 IC=MCLEF(1)+1
21300 CALL OFILE(1,NM)
21400 WRITE(1,120),IC
21500 CALL SAVE(MCLEF)
21510 WRITE(1,1111)NM
21555 1111 FORMAT(' 9999 ',A5)
21600 111 TYPE 110,IC
21610 END FILE(1)
21615 TYPE 1111,NM
21620 GO TO 91
21700 120 FORMAT(' 9999 1 ',I4,' 0 0 0 0 0 0 0 0')
21800 110 FORMAT(' TOTAL WDS=',I3)
21900 END